home *** CD-ROM | disk | FTP | other *** search
- Attribute VB_Name = "TextPrintingModule"
- Global TextArray() As String
-
- Function LoadText(ByVal FNAME As String) As String
- On Error GoTo FNL
- Dim FNUM As Integer
- FNUM = FreeFile
- Open FNAME For Input As #FNUM
- LoadText = Input(LOF(FNUM), FNUM)
- Close #FNUM
- Exit Function
- FNL:
- LoadText = "File could not be loaded!"
- Close #FNUM
- Exit Function
- End Function
-
- Function GetMaxChar(ByVal PIC, ByVal FNT As String, ByVal Sz As Single) As Integer
- Dim h As String
- PIC.FontName = Trim$(FNT)
- PIC.FontSize = Sz
- h = ""
- While PIC.Width > PIC.TextWidth(h)
- h = h + "H"
- Wend
- GetMaxChar = Len(h) - 1
- End Function
-
- Sub TextJustify(ByVal PIC, ByVal TXT As String, ByVal FNTName As String, ByVal FNTSize, ByVal FNTColor As Long)
- On Error GoTo PFAIL
-
- TXT = Replace(TXT, vbCrLf + vbCrLf, "%%")
- TXT = Replace(TXT, vbCrLf, "")
- TXT = Replace(TXT, "%%", vbCrLf)
-
- 'GET MAX CHARACTERS PER ROW
- RW = GetMaxChar(PIC, FNTName, FNTSize)
-
- If Trim$(Alg) = "" Then Alg = "J"
-
- PIC.CurrentX = 567
- PIC.CurrentY = 0
-
- 'CALCULATE SPACE NEED IT FOR EACH CHARACTER
- SC = PIC.Width \ RW
-
- 'STEP TROUGH THE TEXT
- For L = 1 To Len(TXT) Step RW
- TX = Mid$(TXT, L, RW)
-
- xC = InStr(TX, vbCrLf)
- xL = Len(TX) - xC
-
- ' CHECK IF THER IS A CARRIAGE RETURN TO CHANGE THE ROW
- If InStr(TX, vbCrLf) > 0 Then
- INTERLINE = 75
- L = L - xL
- TX = Left(TX, xC)
- Else
- INTERLINE = 25
- If InStr(TX, " ") > 0 Then
- CAR = Right$(TX, 1)
- While CAR <> " "
- CAR = Right$(TX, 1)
- If CAR <> " " Then
- TX = Left$(TX, Len(TX) - 1)
- L = L - 1
- End If
- Wend
- End If
- If InStr(TX, " ") > 0 Then TX = JustifiedAligned(RW, TX)
- End If
-
- TX = Trim$(TX)
-
- ' SET FONT SIZE
- PIC.FontSize = FNTSize
- PIC.FontName = FNTName
- PIC.ForeColor = FNTColor
- PIC.FontItalic = False
- ' CALCULATE INITIAL ROW POSITION
- CY = PIC.CurrentY + INTERLINE
- 'IF TEXT IS OUT OF THE PICTURE BOX THEN SKIP IT TO SPEED UP THE PROCESS
- If CY > PIC.Height Then Exit For
-
- 'READ EACH LETTER IN THE SENTENCE IN ORDER TO CALCULATE ITS POSITION
- For CH = 1 To Len(TX)
- ' GET THE LETTER
- U = Mid$(TX, CH, 1)
- ' SET HORIZONTAL POSITION
- PIC.CurrentX = (CH - 1) * SC
- ' SET ROW POSITION
- PIC.CurrentY = CY
- ' PRINT THE LETTER
- PIC.Print U
- Next CH
- Next L
-
- Exit Sub
- PFAIL:
- Exit Sub
- End Sub
-
- Function JustifiedAligned(ByVal RW As Integer, ByVal S As String) As String
- On Error Resume Next
- S = Trim$(S)
-
- If Len(S) >= RW Then
- JustifiedAligned = S
- Exit Function
- End If
-
- If InStr(S, " ") = 0 Then
- JustifiedAligned = S
- Exit Function
- End If
-
- DX = Abs(Len(S) - RW)
-
- CH = ""
- TMP = ""
- CT = 0
-
- For I = 1 To Len(S)
- CH = Mid$(S, I, 1)
- If CH = " " Then
- CH = " "
- CT = CT + 1
- End If
- TMP = TMP + CH
- If CT >= (DX - 1) Then
- TMP = TMP + Mid$(S, I, Len(S))
- Exit For
- End If
- Next I
-
- If Len(TMP) < RW Then
- TXT = JustifiedAligned(RW, TMP)
- Else
- TXT = TMP
- End If
-
- If Left$(TXT, 1) = Mid$(TXT, 2, 1) Then TXT = Mid$(TXT, 2, Len(TXT) - 1)
- If Right$(TXT, 1) = Mid$(TXT, Len(TXT) - 1, 1) Then TXT = Left$(TXT, Len(TXT) - 1)
-
- JustifiedAligned = Trim$(TXT)
-
- End Function
-
-